home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1997 May / EnigmA AMIGA RUN 18 (1997)(G.R. Edizioni)(IT)[!][issue 1997-05][EAR-CD II].iso / earcd / dev / misc / makedt_1.lha / MakeDT.rexx < prev   
OS/2 REXX Batch file  |  1996-11-17  |  12KB  |  450 lines
  1. /*
  2. **    MakeDT.rexx - ARexx script to create DataType recogs
  3. **    $VER: MakeDT.rexx 1.3 (17.11.96)
  4. **    Written by Michal Letowski
  5. **
  6. **    1.0 (20.12.94) - initial version, not released
  7. **    1.1 (22.11.94) - 1st public version
  8. **    1.2 (29.1.96)  - 2nd public version
  9. **        + now can write FVER chunk
  10. **        ! fixed bug in tags conversion
  11. **    1.3 (17.11.96) - 3rd public version
  12. **        ! fixed numerous bugs
  13. */
  14.  
  15. SIGNAL ON BREAK_C
  16.  
  17. PARSE ARG descrFile outFile .
  18.  
  19. IF descrFile='' THEN
  20. DO
  21.     SAY 'Usage: MakeDT <DescriptionFile> [<DestDataType>]'
  22.     EXIT 20
  23. END
  24.  
  25. IF ~OPEN(FH,descrFile,'R') THEN
  26.     CALL Error('Unable to open description file' descrFile,20)
  27.  
  28. Header.=''                                                                    /* Init header */
  29. Code.=''                                                                        /* Init code */
  30. Code.Exists=0
  31. Tools.=''                                                                        /* Init tool */
  32. DO I=1 TO 5
  33.     Tools.I.Exists=0
  34. END
  35. Tags.=''                                                                        /* Init tags */
  36. Tags.Count=1
  37.  
  38. DO LineNum=1 WHILE ~EOF(FH)
  39.     Line=READLN(FH)
  40.     IF Line='' THEN
  41.         LEAVE
  42.     Line=STRIP(Line,'L')                                            /* Remove leading spaces */
  43.     IF SUBSTR(Line,1,1)='#' THEN                            /* Skip comment */
  44.         ITERATE
  45.     PARSE VAR Line Comm '=' Value
  46.     UPPER Comm
  47.     SELECT
  48.         WHEN ABBREV('FILENAME',Comm) THEN
  49.             IF outFile='' THEN
  50.                 outFile=Value
  51.         WHEN ABBREV('DTNAME',Comm) THEN        CALL ParseDTName(Value,LineNum)
  52.         WHEN ABBREV('ID',Comm) THEN                CALL ParseID(Value,LineNum)
  53.         WHEN ABBREV('VERSION',Comm) THEN    CALL ParseVersion(Value,LineNum)
  54.         WHEN ABBREV('RECOG',Comm) THEN        CALL ParseRecog(Value,LineNum)
  55.         WHEN ABBREV('FLAGS',Comm) THEN        CALL ParseFlags(Value,LineNum)
  56.         WHEN ABBREV('CODE',Comm) THEN            CALL ParseCode(Value,LineNum)
  57.         WHEN ABBREV('TOOL',Comm) THEN            CALL ParseTool(Value,LineNum)
  58.         WHEN ABBREV('TAG',Comm) THEN            CALL ParseTag(Value,LineNum)
  59.         OTHERWISE
  60.             CALL Error('Error in line' LineNum ': Unknown command',10)
  61.     END
  62. END
  63. CALL CLOSE(FH)
  64. CALL Check(outFile)
  65. CALL Consolidate
  66. CALL Write
  67. CALL WriteFile(outFile)
  68.  
  69. EXIT
  70.  
  71.  
  72. /*
  73. **    MakeDT procedures
  74. */
  75. ParseDTName:    PROCEDURE EXPOSE Header.
  76.     PARSE ARG value,line
  77.     PARSE VAR value Header.Name ',' Header.BaseName
  78.     IF Header.Name='' | Header.BaseName='' THEN
  79.         CALL Error('Error in line' line ': <Name> and <BaseName> must not be null',10)
  80. RETURN
  81.  
  82. ParseVersion:    PROCEDURE EXPOSE Header.
  83.     PARSE ARG value,line
  84.     PARSE VAR value Header.Version '.' Header.Revision
  85.     IF ~DATATYPE(Header.Version,'W') | ~DATATYPE(Header.Revision,'W') THEN
  86.         CALL Error('Error in line' line ': <Version> or <Revision> not numeric',10)
  87. RETURN
  88.  
  89. ParseID:    PROCEDURE EXPOSE Header.
  90.     PARSE ARG value,line
  91.     PARSE VAR value Header.GroupID ',' Header.ID
  92.     IF Header.GroupID='' | Header.ID='' THEN
  93.         CALL Error('Error in line' line ': <GroupID> and <FileID> must not be null',10)
  94.     IF FIND('syst text docu soun inst musi pict anim movi',Header.GroupID)=0 THEN
  95.         CALL Error('Warning in line' line ': Unknown <GroupID>',5)
  96.     IF LENGTH(Header.GroupID)>5 | LENGTH(Header.ID)>4 THEN
  97.         CALL Error('Error in line' line ': <GroupID> and <FileID> may be up to 4 chars',10)
  98. RETURN
  99.  
  100. ParseRecog:    PROCEDURE EXPOSE Header.
  101.     PARSE ARG value,line
  102.     PARSE VAR value Header.Pattern ',' Header.Mask
  103.     Header.Mask=CDecode(Header.Mask,line)
  104.     Header.MaskLen=LENGTH(Header.Mask)%2
  105. RETURN
  106.  
  107. ParseFlags:    PROCEDURE EXPOSE Header.
  108.     PARSE ARG value,line
  109.     PARSE UPPER VAR value Type ',' Case ',' Pri
  110.     SELECT
  111.         WHEN ABBREV('BINARY',Type) THEN    Header.Flags=0
  112.         WHEN ABBREV('ASCII',Type) THEN    Header.Flags=1
  113.         WHEN ABBREV('IFF',Type) THEN        Header.Flags=2
  114.         WHEN ABBREV('OTHER',Type) THEN    Header.Flags=3
  115.         OTHERWISE
  116.             CALL Error('Error in line' line ': Type must be <Binary>, <ASCII>, <IFF> or <Other>',10)
  117.     END
  118.     IF Case='Y' THEN
  119.         Header.Flags=Header.Flags+16
  120.     SELECT
  121.         WHEN Pri='' THEN
  122.             Header.Priority=0
  123.         WHEN DATATYPE(Pri,'W') THEN
  124.             IF Pri>=0 & Pri<=65535 THEN
  125.                 Header.Priority=Pri
  126.             ELSE
  127.                 CALL Error('Error in line' line ': <Priority> must be in 0..65535 range',10)
  128.         OTHERWISE
  129.             CALL Error('Error in line' line ': <Priority> not numeric',10)
  130.     END
  131. RETURN
  132.  
  133. ParseCode:    PROCEDURE EXPOSE Code.
  134.     PARSE ARG value,line
  135.     Code.Exists=0
  136.     IF value='' THEN
  137.         RETURN
  138.     Code.Exists=OPEN(CodeFH,value,'R')
  139.     If ~Code.Exists THEN
  140.         CALL Error('Error in line' line ': <Code> file does not exist',10)
  141.     Code.Code=READCH(CodeFH,65536)
  142.     CALL CLOSE(CodeFH)
  143.     Code.Exists=1
  144. RETURN
  145.  
  146. ParseTool:    PROCEDURE EXPOSE Tools.
  147.     PARSE ARG value,line
  148.     IF value='' THEN
  149.         RETURN
  150.     PARSE VAR value Type ',' Name ',' Kind
  151.     UPPER Type
  152.     UPPER Kind
  153.     SELECT
  154.         WHEN ABBREV('INFO',Type) THEN        ToolNumber=1
  155.         WHEN ABBREV('BROWSE',Type) THEN    ToolNumber=2
  156.         WHEN ABBREV('EDIT',Type) THEN        ToolNumber=3
  157.         WHEN ABBREV('PRINT',Type) THEN    ToolNumber=4
  158.         WHEN ABBREV('MAIL',Type) THEN        ToolNumber=5
  159.         OTHERWISE
  160.             CALL Error('Error in line' line ': Unknown tool type',10)
  161.     END
  162.     SELECT
  163.         WHEN ABBREV('CLI',Kind) THEN                Tools.ToolNumber.Flags=1
  164.         WHEN ABBREV('WORKBENCH',Kind) THEN    Tools.ToolNumber.Flags=2
  165.         WHEN ABBREV('AREXX',Kind) THEN            Tools.ToolNumber.Flags=3
  166.         OTHERWISE
  167.             CALL Error('Error in line' line ': Unknown kind of tool',10)
  168.     END
  169.     IF Name='' THEN
  170.         CALL Error('Error in line' line ': <ToolName> must not be null',10)
  171.     Tools.ToolNumber.Program=Name
  172.     Tools.ToolNumber.Exists=1
  173. RETURN
  174.  
  175. ParseTag:    PROCEDURE EXPOSE Tags.
  176.     PARSE ARG value,line
  177.     IF value='' THEN
  178.         RETURN
  179.     Counter=Tags.Count
  180.     PARSE UPPER VAR value TagName ',' TagValue
  181.     IF TagName='' | TagValue='' THEN
  182.         CALL Error('Error in line' line ': <TagName> or <TagValue> empty',10)
  183.     IF SUBSTR(TagName,1,1)='$' THEN DO
  184.         IF ~DATATYPE(SUBSTR(TagName,2),'X') THEN
  185.             CALL Error('Error in line' line ': <TagName> not numeric',10)
  186.         ELSE
  187.             Tags.Counter.Name=X2C(SUBSTR(TagName,2))
  188.     END
  189.     ELSE DO
  190.         IF ~DATATYPE(TagName,'W') THEN
  191.             CALL Error('Error in line' line ': <TagName> not numeric',10)
  192.         ELSE
  193.             Tags.Counter.Name=D2C(TagName)
  194.     END
  195.     IF SUBSTR(TagValue,1,1)='$' THEN DO
  196.         IF ~DATATYPE(SUBSTR(TagValue,2),'X') THEN
  197.             CALL'Error in line' line ': <TagValue> not numeric',10)
  198.         ELSE
  199.             Tags.Counter.Val=X2C(SUBSTR(TagValue,2))
  200.     END
  201.     ELSE DO
  202.         IF ~DATATYPE(TagValue,'W') THEN
  203.             CALL Error('Error in line' line ': <TagValue> not numeric',10)
  204.         ELSE
  205.             Tags.Counter.Val=D2C(TagValue)
  206.     END
  207.     Tags.Count=Tags.Count+1
  208. RETURN
  209.  
  210. CDecode: PROCEDURE
  211.     PARSE ARG encoded,line
  212.     Decoded=''
  213.     DO I=1 TO LENGTH(encoded)
  214.         IF SUBSTR(encoded,I,1)='\' THEN DO
  215.             I=I+1
  216.             SELECT
  217.                 WHEN SUBSTR(encoded,I,1)='?' THEN
  218.                     Decoded=Decoded||'FFFF'X
  219.                 WHEN SUBSTR(encoded,I,1)='\' THEN
  220.                     Decoded=Decoded||'00'X||'\'
  221.                 WHEN SUBSTR(encoded,I,1)='$' THEN DO
  222.                     Hex=SUBSTR(encoded,I+1,2)
  223.                     IF DATATYPE(Hex,'X') THEN DO
  224.                         Decoded=Decoded||'00'X||X2C(Hex)
  225.                         I=I+2
  226.                     END
  227.                     ELSE
  228.                         CALL Error('Error in line' line ": Hexadecimal number expected after '$'",10)
  229.                 END
  230.                 OTHERWISE
  231.                     CALL Error('Error in line' line ': Unknown escape character',10)
  232.             END
  233.         END
  234.         ELSE
  235.             Decoded=Decoded||'00'X||SUBSTR(encoded,I,1)
  236.     END
  237. RETURN Decoded
  238.  
  239. Check:    PROCEDURE EXPOSE Header.
  240.     PARSE ARG file
  241.     IF file='' THEN
  242.         CALL Error('Error: <DestFile> must not be null',10)
  243.     IF Header.Name='' | Header.BaseName='' THEN
  244.         CALL Error('Error: <Name> and <BaseName> must not be null',10)
  245.     IF Header.GroupID='' | Header.ID='' THEN
  246.         CALL Error('Error: <GroupID> and <FileID> must not be null',10)
  247.     IF Header.Pattern='' & Header.Mask='' THEN
  248.         CALL Error('Warning: Both <Pattern> and <Mask> are null',5)
  249. RETURN
  250.  
  251. Consolidate:    PROCEDURE EXPOSE Header.
  252. SAY Header.Version'.'Header.revision
  253.     /* Consolidate version string */
  254.     Header.VerString='$VER:'
  255.     Header.VerString=Header.VerString Header.Name
  256.     Header.VerString=Header.VerString Header.Version'.'Header.Revision
  257.     Header.VerString=Header.VerString '('MakeDate()')'
  258. RETURN
  259.  
  260.  
  261. Write:    PROCEDURE EXPOSE Header. Code. Tools. Tags.
  262.     TAB='09'X
  263.     SAY 'Version:   '||Header.VerString
  264.     SAY 'Name:      '||Header.Name
  265.     SAY 'Base name: '||Header.BaseName
  266.     SAY 'Group ID:  '||Header.GroupID
  267.     SAY 'ID:        '||Header.ID
  268.     SAY 'Pattern:   '||Header.Pattern
  269.     SAY 'Mask len:  '||Header.MaskLen
  270.     SAY 'Mask:      '||Header.Mask
  271.     SAY 'Flags:     '||Header.Flags
  272.     SAY 'Priority:  '||Header.Priority
  273.     SAY
  274.     IF Code.Name~='' THEN
  275.     DO
  276.         SAY 'Function name: '||Code.Name
  277.         SAY
  278.     END
  279.     DO I=1 TO 5
  280.         IF Tools.I.Exists THEN
  281.         DO
  282.             SAY 'Tool name:   ' Tools.I.Program
  283.             SAY 'Type of tool:' I
  284.             SAY 'Kind of tool:' Tools.I.Flags
  285.             SAY
  286.         END
  287.     END
  288.     DO I=1 TO Tags.Count-1
  289.         SAY 'Tag name:' C2X(Tags.I.Name) 'Tag value:' C2D(Tags.I.Val)
  290.     END
  291. RETURN
  292.  
  293. WriteFile:    PROCEDURE EXPOSE Header. Code. Tools. Tags.
  294.     PARSE ARG file
  295.     Header.Name=Header.Name||'0'X
  296.     Header.BaseName=Header.BaseName||'0'X
  297.     Header.Pattern=Header.Pattern||'0'X
  298.     Header.VerString=Header.VerString||'0'X
  299.     DO I=1 TO 5
  300.         Tools.I.Program=Tools.I.Program||'0'X
  301.     END
  302.     NameLen=Len(FilePart(file)'0'X)
  303.     VerLen=Len(Header.VerString)
  304.     HeaderLen=Len(Header.Name)+Len(Header.BaseName)+Len(Header.Pattern)
  305.     HeaderLen=HeaderLen+32+Header.MaskLen*2
  306.     CodeLen=Len(Code.Code)
  307.     DO I=1 TO 5
  308.         ToolLen.I=8+Len(Tools.I.Program)
  309.     END
  310.     TagsLen=(Tags.Count-1)*8
  311.     TagsExist=Tags.Count>1
  312.     TotalLen=4
  313.     IF Header.VerString~='0'X THEN
  314.         TotalLen=TotalLen+8+VerLen
  315.     TotalLen=TotalLen+8+NameLen
  316.     TotalLen=TotalLen+8+HeaderLen
  317.     TotalLen=TotalLen+(8+CodeLen)*Code.Exists
  318.     DO I=1 TO 5
  319.         TotalLen=TotalLen+(8+ToolLen.I)*Tools.I.Exists
  320.     END
  321.     TotalLen=TotalLen+(8+TagsLen)*TagsExist
  322.     IF ~OPEN(FH,file,'W') THEN
  323.         CALL Error('Unable to open output file' file,20)
  324.  
  325.     /* Save header */
  326.     CALL WRITECH(FH,'FORM')
  327.     CALL WRITECH(FH,Long(TotalLen))
  328.     CALL WRITECH(FH,'DTYP')
  329.  
  330.     /* Save FVER chunk */
  331.     IF Header.VerString~='0'X THEN
  332.     DO
  333.         CALL WRITECH(FH,'FVER')
  334.         CALL WRITECH(FH,Long(VerLen))
  335.         CALL WRITECH(FH,Pad(Header.VerString))
  336.     END
  337.  
  338.     /* Save NAME chunk */
  339.     CALL WRITECH(FH,'NAME')
  340.     CALL WRITECH(FH,Long(NameLen))
  341.     CALL WRITECH(FH,Pad(FilePart(file)'0'X))
  342.  
  343.     /* Save DTHD chunk */
  344.     CALL WRITECH(FH,'DTHD')
  345.     CALL WRITECH(FH,Long(HeaderLen))
  346.     CALL WRITECH(FH,Long(32+Header.MaskLen*2))
  347.     CALL WRITECH(FH,Long(32+Header.MaskLen*2+Len(Header.Name)))
  348.     CALL WRITECH(FH,Long(32+Header.MaskLen*2+Len(Header.Name)+Len(Header.BaseName)))
  349.     CALL WRITECH(FH,Long(32))
  350.     CALL WRITECH(FH,PadR(Header.GroupID))
  351.     CALL WRITECH(FH,PadR(Header.ID))
  352.     CALL WRITECH(FH,Word(Header.MaskLen))
  353.     CALL WRITECH(FH,Word(0))
  354.     CALL WRITECH(FH,Word(Header.Flags))
  355.     CALL WRITECH(FH,Word(Header.Priority))
  356.     CALL WRITECH(FH,Header.Mask)
  357.     CALL WRITECH(FH,Pad(Header.Name))
  358.     CALL WRITECH(FH,Pad(Header.BaseName))
  359.     CALL WRITECH(FH,Pad(Header.Pattern))
  360.  
  361.     /* Save DTCD chunk */
  362.     IF Code.Exists THEN
  363.     DO
  364.         CALL WRITECH(FH,'DTCD')
  365.         CALL WRITECH(FH,Long(CodeLen))
  366.         CALL WRITECH(FH,Pad(Code.Code))
  367.     END
  368.  
  369.     /* Save DTTL chunk */
  370.     DO I=1 TO 5    
  371.         IF Tools.I.Exists THEN
  372.         DO
  373.             CALL WRITECH(FH,'DTTL')
  374.             CALL WRITECH(FH,Long(ToolLen.I))
  375.             CALL WRITECH(FH,Word(I))
  376.             CALL WRITECH(FH,Word(Tools.I.Flags))
  377.             CALL WRITECH(FH,Long(8))
  378.             CALL WRITECH(FH,Pad(Tools.I.Program))
  379.         END
  380.     END
  381.  
  382.     /* Save DTTG chunk */
  383.     IF Tags.Count>1 THEN DO
  384.         CALL WRITECH(FH,'DTTG')
  385.         CALL WRITECH(FH,Long(TagsLen))
  386.         DO I=1 To Tags.Count-1
  387.             CALL WRITECH(FH,RIGHT(Tags.I.Name,4,'0'X)||RIGHT(Tags.I.Val,4,'0'X))
  388.         END
  389.     END
  390.     
  391.     SAY 'DataType written!'
  392. RETURN
  393.  
  394. Error:    PROCEDURE
  395.     PARSE ARG string,code
  396.     SAY string
  397.     IF code>5 THEN
  398.         EXIT code
  399.     ELSE
  400.         RETURN
  401.  
  402.  
  403. /*
  404. **    Utility procedures
  405. */
  406. Len:    PROCEDURE
  407.     PARSE ARG string
  408.     L=LENGTH(string)
  409.     IF L//2=0 THEN
  410.         RETURN L
  411.     ELSE
  412.         RETURN L+1
  413.  
  414. Pad:    PROCEDURE
  415.     PARSE ARG string
  416.     L=LENGTH(string)
  417.     IF L//2=0 THEN
  418.         RETURN string
  419.     ELSE
  420.         RETURN string||'00'X
  421.  
  422. PadR:    PROCEDURE
  423.     PARSE ARG string
  424. RETURN LEFT(string,4,'0'X)
  425.  
  426. Word:    PROCEDURE
  427.     PARSE ARG num .
  428. RETURN RIGHT(D2C(num),2,'0'X)
  429.  
  430. Long:    PROCEDURE
  431.     PARSE ARG num .
  432. RETURN RIGHT(D2C(num),4,'0'X)
  433.  
  434. FilePart:    PROCEDURE
  435.     PARSE ARG path
  436.     SepPos=Max(LastPos('/',path),LastPos(':',path))+1
  437.     PARSE VAR path PathPart =SepPos FilePart
  438. RETURN FilePart
  439.  
  440. MakeDate:    PROCEDURE
  441.     PARSE VALUE Date('E') WITH day '/' month '/' year
  442.     IF LEFT(day,1)='0'     THEN    PARSE VAR day '0' day
  443.     IF LEFT(month,1)='0' THEN    PARSE VAR month '0' month
  444. RETURN day'.'month'.'year
  445.     
  446.  
  447. BREAK_C:
  448.     SAY 'DataType not written!'
  449.     EXIT
  450.